home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
mint
/
editors
/
mntemacs.zoo
/
src
/
callproc.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-04-07
|
14KB
|
562 lines
/* Synchronous subprocess invocation for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
/**
** (sjk)++ The space to build a temporary file name.
** Dev null installed flag, do not install /dev/null
** until emacs is run in interactive mode (not in dumps).
**/
#if defined(atarist)
char at_tmpname[32];
#ifndef __MINT__
static short null_dev_inst = 0;
#endif
#endif
#include <signal.h>
#include "config.h"
#include <sys/types.h>
#define PRIO_PROCESS 0
#include <sys/file.h>
#ifdef USG5
#include <fcntl.h>
#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "paths.h"
#define max(a, b) ((a) > (b) ? (a) : (b))
Lisp_Object Vexec_path, Vexec_directory;
Lisp_Object Vshell_file_name;
#ifndef MAINTAIN_ENVIRONMENT
/* List of strings to append to front of environment of
all subprocesses when they are started. */
Lisp_Object Vprocess_environment;
#endif
#ifdef BSD4_1
/* Set nonzero when a synchronous subprocess is made,
and set to zero again when it is observed to die.
We wait for this to be zero in order to wait for termination. */
int synch_process_pid;
#endif /* BSD4_1 */
Lisp_Object
call_process_cleanup (fdpid)
Lisp_Object fdpid;
{
register Lisp_Object fd, pid;
fd = Fcar (fdpid);
pid = Fcdr (fdpid);
/**
** (sjk)++ We close the file in the function from where the external
** process was creaed.
**/
#if defined(atarist) && !defined(__MINT__)
if (XFASTINT(fd)>0) close (XFASTINT (fd));
#else
close (XFASTINT (fd));
kill (XFASTINT (pid), SIGKILL);
#endif
return Qnil;
}
#ifdef VMS
extern noshare char **environ;
#else
extern char **environ;
#endif
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
"Call PROGRAM in separate process.\n\
Program's input comes from file INFILE (nil means /dev/null).\n\
Insert output in BUFFER before point; t means current buffer;\n\
nil for BUFFER means discard it; 0 means discard and don't wait.\n\
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining arguments are strings passed as command arguments to PROGRAM.\n\
This function waits for PROGRAM to terminate;\n\
if you quit, the process is killed.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
Lisp_Object display, buffer, path;
int fd[2];
int filefd;
register int pid;
char buf[1024];
int count = specpdl_ptr - specpdl;
register unsigned char **new_argv
= (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
struct buffer *old = current_buffer;
/**
** (sjk)++ Install bammi's plug&play null data sink.
**/
#if defined(atarist)
#ifndef __MINT__
if (!null_dev_inst)
{ install_null();
null_dev_inst = 1;
}
#endif
#endif
CHECK_STRING (args[0], 0);
if (nargs <= 1 || NULL (args[1]))
#ifdef VMS
args[1] = build_string ("NLA0:");
#else
args[1] = build_string ("/dev/null");
#endif /* not VMS */
else
args[1] = Fexpand_file_name (args[1], current_buffer->directory);
CHECK_STRING (args[1], 1);
{
register Lisp_Object tem;
buffer = tem = args[2];
if (nargs <= 2)
buffer = Qnil;
else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
|| XFASTINT (tem) == 0))
{
buffer = Fget_buffer (tem);
CHECK_BUFFER (buffer, 2);
}
}
display = nargs >= 3 ? args[3] : Qnil;
{
register int i;
for (i = 4; i < nargs; i++)
{
CHECK_STRING (args[i], i);
new_argv[i - 3] = XSTRING (args[i])->data;
}
/* Program name is first command arg */
new_argv[0] = XSTRING (args[0])->data;
new_argv[i - 3] = 0;
}
/**
** (sjk)++ Open temp file in R/W mode on the ST...
**/
#if defined(atarist) && !defined(__MINT__)
filefd = open (XSTRING (args[1])->data, O_RDWR , 666);
#else
filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
#endif
if (filefd < 0)
{
report_file_error ("Opening process input file", Fcons (args[1], Qnil));
}
/* Search for program; barf if not found. */
/**
** (sjk)++ When searching for executables check some obvious extensions.
**/
#if defined(atarist)
openp (Vexec_path, args[0], ":ttp:tos:prg", &path, 1);
#else
openp (Vexec_path, args[0], "", &path, 1);
#endif
if (NULL (path))
{
close (filefd);
report_file_error ("Searching for program", Fcons (args[0], Qnil));
}
new_argv[0] = XSTRING (path)->data;
if (XTYPE (buffer) == Lisp_Int)
#ifdef VMS
fd[1] = open ("NLA0:", 0), fd[0] = -1;
#else
fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
#endif /* not VMS */
else
{
pipe (fd);
#if 0
/* Replaced by close_process_descs */
set_exclusive_use (fd[0]);
#endif
}
{
/* child_setup must clobber environ in systems with true vfork.
Protect it from permanent change. */
register char **save_environ = environ;
register int fd1 = fd[1];
char **env;
#ifdef MAINTAIN_ENVIRONMENT
env = (char **) alloca (size_of_current_environ ());
get_current_environ (env);
#else
env = environ;
#endif /* MAINTAIN_ENVIRONMENT */
pid = vfork ();
#ifdef BSD4_1
/* cause SIGCHLD interrupts to look for this pid. */
synch_process_pid = pid;
#endif /* BSD4_1 */
if (pid == 0)
{
/**
** (sjk)++ Avoid some excess file closes.
**/
#if !defined(atarist) || defined(__MINT__)
if (fd[0] >= 0)
close (fd[0]);
#ifdef USG
#ifdef HAVE_PTYS
setpgrp ();
#endif
#endif
#endif /* !defined(atarist) */
child_setup (filefd, fd1, fd1, new_argv, env);
}
environ = save_environ;
close (filefd);
close (fd1);
}
if (pid < 0)
{
/**
** (sjk)++ Make sure both end of pipe get closed if vfork() fails
**/
#if defined(atarist) && !defined(__MINT__)
close (fd[1]);
#endif
close (fd[0]);
report_file_error ("Doing vfork", Qnil);
}
if (XTYPE (buffer) == Lisp_Int)
{
#ifndef subprocesses
wait_without_blocking ();
#endif subprocesses
return Qnil;
}
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), make_number (pid)));
if (XTYPE (buffer) == Lisp_Buffer)
Fset_buffer (buffer);
immediate_quit = 1;
QUIT;
{
register int nread;
while ((nread = read (fd[0], buf, sizeof buf)) > 0)
{
immediate_quit = 0;
if (!NULL (buffer))
insert (buf, nread);
if (!NULL (display) && FROM_KBD)
redisplay_preserve_echo_area ();
immediate_quit = 1;
QUIT;
}
}
/**
** (sjk)++ here we close the write side of the pipe.
**/
#if defined(atarist) && !defined(__MINT__)
close(fd[0]);
#endif
/* Wait for it to terminate, unless it already has. */
wait_for_termination (pid);
immediate_quit = 0;
set_buffer_internal (old);
unbind_to (count);
return Qnil;
}
DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
3, MANY, 0,
"Send text from START to END to a process running PROGRAM.\n\
Delete the text if DELETE is non-nil.\n\
Put output in BUFFER, before point. nil => discard it, t => current buffer.\n\
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining args are passed to PROGRAM at startup as command args.\n\
This function normally waits for the process to terminate;\n\
if you quit, the process is killed.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
register Lisp_Object filename_string, start, en